home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / More classes / Bitstring next >
Encoding:
Text File  |  1990-12-24  |  4.1 KB  |  228 lines  |  [TEXT/MSET]
  1. \ BITSTRING class.  May 88.
  2.  
  3. need    bytestring
  4.  
  5.  
  6. :code BLOCATE    \ ( n b -- bit-index OR -1 )
  7.  
  8. \ Bit locate.  bit-index points to the 1st occurrence of bit b in n,
  9. \ proceeding from left to right.  The leftmost bit has index zero
  10. \ (sensibly, unlike the usual 68000 convention).  If the bit is not
  11. \ found we return -1.
  12. \ This code was lifted from the earlier PDP-11 version.  DEC numbers
  13. \ bits the wrong way round, too.  So does Intel.  But IBM are OK!!!!
  14. \ (Alright, alright, so we're strictly big-endian around here.)
  15.  
  16.     loc
  17.     MOVEQ    #-1,D0        ; Initial result
  18.     TST    (SP)+
  19.     BNE.S    getn
  20.     NOT    (SP)
  21. getn    MOVE    (SP),D1
  22.     BEQ.S    end
  23. lp    ADDQ    #1,D0
  24.     ROL    #1,D1
  25.     BCC.S    lp
  26. end    MOVE    D0,(SP)
  27. ;code
  28.  
  29.  
  30. :class BITSTRING    super( bytestring )
  31.  
  32.     int    BP
  33.     int    BL
  34.  
  35. :mcode BPOS:
  36.     MOVE    8(A2),D0
  37.     LSL    #3,D0
  38.     OR.W    18(A2),D0
  39.     PUSH    D0
  40. ;mcode
  41.  
  42. :mcode BLIM:
  43.     MOVE    12(A2),D0
  44.     LSL    #3,D0
  45.     OR.W    20(A2),D0
  46.     PUSH    D0
  47. ;mcode
  48.  
  49. :mcode >BPOS:
  50.     POP    D0
  51.     MOVE    D0,D1
  52.     ANDI    #7,D1
  53.     MOVE.W    D1,18(A2)
  54.     LSR    #3,D0
  55.     MOVE    D0,8(A2)
  56. ;mcode
  57.  
  58. :mcode >BLIM:
  59.     POP    D0
  60.     MOVE    D0,D1
  61.     ANDI    #7,D1
  62.     MOVE.W    D1,20(A2)
  63.     LSR    #3,D0
  64.     MOVE    D0,12(A2)
  65. ;mcode
  66.  
  67. :mcode BLEN:
  68.     MOVE    8(A2),D0
  69.     LSL    #3,D0
  70.     OR.W    18(A2),D0
  71.     MOVE    12(A2),D1
  72.     LSL    #3,D1
  73.     OR.W    20(A2),D1
  74.     SUB    D0,D1
  75.     PUSH    D1
  76. ;mcode
  77.  
  78. :mcode >BLEN:
  79.     MOVE    8(A2),D0
  80.     LSL    #3,D0
  81.     OR.W    18(A2),D0
  82.     ADD    (SP)+,D0
  83.     MOVE    D0,D1
  84.     ANDI    #7,D1
  85.     MOVE.W    D1,20(A2)
  86.     LSR    #3,D0
  87.     MOVE    D0,12(A2)
  88. ;mcode
  89.  
  90. :m BSKIP:    bpos: self  +  >bpos: self  ;m
  91.  
  92. :m START:    clear: pos  clear: bp     ;m
  93. :m NOLIM:    nolim: super  clear: bl   ;m
  94. :m RESET:    start: self  nolim: self  ;m
  95.  
  96. :m BSTEP:    get: lim  get: bl  put: bp  put: pos  nolim: self  ;m
  97. :m <BSTEP:    get: pos  get: bp  put: bl  put: lim   clear: pos  ;m
  98.  
  99.  
  100. :m ROUNDBPOS:    \ Rounds BPOS up to a byte boundary.
  101.     get: bp  0<>  -: pos  clear: bp  ;m
  102.  
  103. :m ROUNDBLIM:
  104.     get: bl  0<>  -: lim  clear: bl  ;m
  105.  
  106. :mcode (>NXTNB):
  107.     loc
  108. \    call    debugger
  109.     MOVEM.L    D3/D4/D7,-(A7)
  110.     POP    D1        ; D1 = #bits
  111.     POP    D0        ; D0 = n
  112.     MOVEQ    #32,D2
  113.     SUB    D1,D2        ; D2 = left shift quantity
  114.     MOVE.W    18(A2),D3    ; D3 = bp
  115.     LSL    D2,D0
  116.     LSR    D3,D0        ; align n in D0
  117.     MOVEQ    #-1,D1
  118.     LSL    D2,D1
  119.     LSR    D3,D1        ; D1 = aligned mask
  120.     MOVE    (A2),A0        ; A0 = handle
  121.     MOVE    (A0),A0        ; Dereference it - addr of start of string
  122.     ADD    8(A2),A0    ; Add POS, giving addr of start of active part
  123.     MOVEQ    #3,D7
  124. lp1    LSL    #8,D4
  125.     MOVE.B    (A0)+,D4
  126.     DBRA    D7,lp1
  127.     NOT    D1
  128.     AND    D1,D4
  129.     OR    D0,D4
  130.     MOVEQ    #3,D7
  131. lp2    move.b    D4,-(A0)
  132.     LSR    #8,D4
  133.     DBRA    D7,lp2
  134.     MOVEM.L    (A7)+,D3/D4/D7
  135. ;mcode
  136.  
  137. :m >NXTNB:  { n #bits -- }
  138.     \ Overwrites #bits bits of SELF with n, which is right justified.  
  139.     \ Updates BPOS.  #bits must be less than 25.
  140.  
  141.     n #bits  (>nxtnb): self
  142.     #bits  bskip: self  ;m
  143.  
  144.  
  145. :mcode BFIND:        \ ( flg -- n b )
  146.         \ Updates BPOS.  n is #bits scanned.
  147.     loc
  148. \    call    debugger
  149.     MOVEM.L    D3/D4/D7,-(A7)
  150.     MOVE    (SP),D1        ; D1 = boolean we're looking for
  151.     SEQ    D1        ; Set to inverse for search on not equal
  152.     CLR    -(SP)        ; For return result
  153.     BSR    dic[getit]
  154.     BLE.S    failed
  155.     MOVE.B    (A0),D7        ; Save 1st char in D7
  156.     MOVE    A0,A1        ; and its addr in A1
  157.     MOVE.W    18(A2),D3
  158.     MOVE.W    #$00FF,D4
  159.     LSR.W    D3,D4
  160.     AND.B    D4,(A0)
  161.     NOT.B    D4
  162.     AND.B    D1,D4
  163.     OR.B    D4,(A0)
  164.     MOVEQ    #0,D4        ; Set "equal"
  165.     BRA.S    lptst
  166.  
  167. lp    CMP.B    (A0)+,D1
  168. lptst    DBNE    D0,lp
  169.     DBNE    D2,lp
  170.     BEQ.S    failed
  171.     SUBQ    #1,(SP)        ; We found it
  172.     SUBQ    #1,A0
  173.     MOVE.B    (A0),D0
  174.     EOR.B    D1,D0
  175.     MOVEQ    #-1,D4
  176. lp2    ADDQ    #1,D4
  177.     ROL.B    #1,D0
  178.     BCC.S    lp2
  179.     BRA.S    rslts
  180.  
  181. failed    MOVE    12(A2),A0
  182.     ADD    dic[$start],A0
  183.     MOVE.W    20(A2),D4
  184.  
  185. rslts    MOVE    8(A2),D0
  186.     LSL    #3,D0
  187.     OR.W    18(A2),D0    ; Old BPOS to D0
  188.     MOVE    A0,D1
  189.     SUB    dic[$start],D1
  190.     MOVE    D1,8(A2)    ; Set POS to found posn
  191.     LSL    #3,D1
  192.     OR.W    D4,D1        ; New BPOS to D1
  193.     MOVE.W    D4,18(A2)
  194.     SUB    D0,D1
  195.     MOVE    D1,4(SP)
  196. end    MOVE.B    D7,(A1)        ; Restore first char
  197.     MOVEM.L    (A7)+,D3/D4/D7
  198. ;mcode
  199.  
  200.  
  201. \ :m BSEARCH:  { flg \ sav1st savpos -- b }
  202. \    1st: self  -> sav1st  get: pos  -> savpos
  203. \    $ FF00  get: bp  >>  ^1st: self
  204. \    flg IF  creset  0  ELSE  cset  -1  THEN
  205. \    chskip?: self  dup
  206. \    IF  ( found )
  207. \        1st: self  24 <<  flg  blocate  put: bl
  208. \        get: pos  put: lim
  209. \        savpos  put: pos
  210. \    THEN    
  211. \    sav1st  ptr: self  savpos +  c!  ;m    \ Restore 1st char
  212.  
  213. :m DUMP:
  214.     ." bpos:"  bpos: self  .h  ."  blim:"  blim: self  .h  cr
  215.     dump: super  ;m
  216.  
  217. ;class
  218.  
  219. endload
  220.  
  221. bitstring  BB
  222.  
  223. : GO
  224.     new: bb  " hello"  put: bb
  225.     get: bb erase  3 skip: bb 4 >nxtc: bb reset: bb  ;
  226.  
  227. : zz  release: bb  ;
  228.